VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "TestReport"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Private repSheet As Worksheet
Private testObjects As Long
Private testsRun As Long
Private testsPassed As Long
Private testsFailed As Long
Private currentRow As Long
Private myTitle As String
Private showingAll As String

Private Const xlColourRed = 38
Private Const xlColourGreen = 35

' ========== <ASSERTS> ==========
Public Sub Assert(worked As Boolean, Optional msg As String = "")
    If worked Then
        ReportPassedTest msg
    Else
        ReportFailedTest "Assertion Failed", msg
    End If
End Sub

Public Sub AssertEqual(expected As Variant, actual As Variant, Optional msg As String = "")
    If expected = actual Then
        ReportPassedTest msg
    Else
        ReportFailedTest "expected " & delimString(expected) & " got " & delimString(actual), msg
    End If
End Sub

Public Sub AssertNotNothing(something As Object, Optional msg As String = "")

    If something Is Nothing Then
        ReportFailedTest "expected object to exist", msg
    Else
        ReportPassedTest msg
    End If

End Sub

Public Sub AssertInDelta(expected As Variant, actual As Variant, delta As Variant, Optional msg As String = "")
    If IsNumeric(expected) And IsNumeric(actual) Then
        If Abs(expected - actual) <= delta Then
            ReportPassedTest msg
        Else
            ReportFailedTest "expected " & delimString(expected) & " got " & delimString(actual), msg
        End If
    Else
        ReportFailedTest "expected numeric data: " & delimString(expected) & ", " & delimString(actual), msg
    End If
End Sub

Public Sub AssertSheetExists(wkbk As Workbook, sheetname As String, Optional msg As String = "")

Dim wksh As Worksheet

    For Each wksh In wkbk.Worksheets
        If LCase(wksh.Name) = LCase(sheetname) Then
            ReportPassedTest msg
            Exit Sub
        End If
    Next
    
    ReportFailedTest "expected sheet " & delimString(sheetname) & " not found in " & wkbk.Name, msg

End Sub

Public Sub AssertWorkbookLoaded(wkbkName As String, Optional msg As String = "")

Dim wkbk As Workbook

    For Each wkbk In Workbooks
        If LCase(wkbk.Name) = LCase(wkbkName) Then
            ReportPassedTest msg
            Exit Sub
        End If
    Next
    
    ReportFailedTest "expected workbook " & delimString(wkbkName) & " not found in Workbooks", msg

End Sub

Public Sub AssertNameExists(wkbk As Workbook, nameToCheck As String, Optional msg As String = "")

    If NameExistsInWorkbook(wkbk, nameToCheck) Then
        ReportPassedTest msg
        Exit Sub
    End If
    
    ReportFailedTest "expected name " & delimString(nameToCheck) & " to exist in " & wkbk.Name, msg

End Sub

Public Sub AssertRangeValueEqual(expected As Variant, wkbk As Workbook, sheetname As String, rangeaddress As String, Optional msg As String = "")

Dim testRange As Range

    On Error Resume Next
    Set testRange = wkbk.sheets(sheetname).Range(rangeaddress)
    If Err.Number <> 0 Then
        ReportFailedTest "[" & wkbk.Name & "]" & sheetname & "!" & testRange.Address & " not found", msg
        Exit Sub
    End If
    On Error GoTo 0

    If expected = testRange.Value Then
        ReportPassedTest msg
    Else
        ReportFailedTest "expected [" & wkbk.Name & "]" & sheetname & "!" & testRange.Address _
                    & " to contain " & delimString(expected) & ", found " & delimString(testRange.Value), msg
    End If
    
End Sub

Public Sub AssertRangeObjectValueEqual(expected As Variant, testRange As Range, Optional msg As String = "")

    With testRange

        If expected = .Value Then
            ReportPassedTest msg
        Else
            ReportFailedTest "expected [" & .Worksheet.Parent.Name & "]" _
                        & .Worksheet.Name & "!" & .Address _
                        & " to contain " & delimString(expected) _
                        & ", found " & delimString(.Value), msg
        End If
    
    End With
    
End Sub

Public Sub AssertKeyInCollection(expectedValue As Variant, resultColl As Collection, Optional msg As String = "")
' TODO: not tested properly yet...
Dim thisVal As Variant

    If resultColl Is Nothing Then
        ReportFailedTest "expected collection object to exist", msg
        Exit Sub
    End If

    On Error Resume Next
    Set thisVal = resultColl(expectedValue)
    If Err.Number = 0 Then
        ReportPassedTest msg
        Exit Sub
    Else
        ' if the value wasn't an object, would we have got an error?
        Err.Clear
        thisVal = resultColl(expectedValue)
        If Err.Number = 0 Then
            ReportPassedTest msg
            Exit Sub
        End If
    End If
    On Error GoTo 0
    
    ReportFailedTest "expected collection to contain key: " & delimString(expectedValue), msg
    
End Sub

Public Sub AssertValueInCollection(expectedValue As Variant, resultColl As Collection, Optional msg As String = "")

Dim thisVal As Variant

    If resultColl Is Nothing Then
        ReportFailedTest "expected collection object to exist", msg
        Exit Sub
    End If

    For Each thisVal In resultColl
        If thisVal = expectedValue Then
            ReportPassedTest msg
            Exit Sub
        End If
    Next
    
    ReportFailedTest "expected collection to contain " & delimString(expectedValue), msg
    
End Sub
' ========== </ASSERTS> ==========

Private Function NameExistsInWorkbook(wb As Workbook, nm As String) As Boolean

Dim checkName As Name

    For Each checkName In wb.Names
        If checkName.Name = nm Then
            NameExistsInWorkbook = True
            Exit Function
        End If
    Next
    
    NameExistsInWorkbook = False

End Function


Public Sub RecordNewTestObject(newTitle As String)
    myTitle = newTitle
    testObjects = testObjects + 1
End Sub

Public Property Set reportSheet(sheetToUse As Worksheet)
    
    Set repSheet = sheetToUse
    
    currentRow = 2
    
    With repSheet
        With .Cells
            .ClearContents
            .ClearFormats
        End With
    
        With .Cells(1, 3).Resize(1, 3)
            .Value = Array("Test Class", "Result", "Message")
            .Font.Bold = True
        End With
    End With
    
End Property

Public Sub Summarise()

Dim summary As Range

    With repSheet
        
        .Activate
        
        Set summary = .Cells(1, 1).Resize(4, 2)
    
        .Cells(1, 1) = "Test classes executed"
        .Cells(1, 2) = testObjects
    
        .Cells(2, 1) = "Tests run:"
        .Cells(2, 2) = testsRun
    
        .Cells(3, 1) = "Passed:"
        .Cells(3, 2) = testsPassed
    
        .Cells(4, 1) = "Failed:"
        .Cells(4, 2) = testsFailed
        
        summary.Font.Bold = True
        
        If testsFailed > 0 Then
            .Cells.Interior.ColorIndex = xlColourRed
        Else
            .Cells.Interior.ColorIndex = xlColourGreen
        End If
    
        .Activate
    
    End With
    
End Sub

Private Sub ReportPassedTest(msg As String)
    AddTestRun
    testsPassed = testsPassed + 1
    If showingAll Then
        WritereportLine "test passed", msg
    End If
End Sub

Private Sub ReportFailedTest(testmsg As String, msg As String)
    AddTestRun
    testsFailed = testsFailed + 1
    WritereportLine testmsg, msg
End Sub

Private Sub WritereportLine(testmsg As String, msg As String)

    repSheet.Cells(currentRow, 3) = myTitle
    repSheet.Cells(currentRow, 4) = testmsg
    repSheet.Cells(currentRow, 5) = msg
    
    currentRow = currentRow + 1

End Sub

Private Sub AddTestRun()
    testsRun = testsRun + 1
End Sub

Private Sub Class_Initialize()
    showingAll = theFactory.ConfigObject.ShowAllTests
End Sub

Private Function delimString(inputThing As Variant) As String
    delimString = "<" & CStr(inputThing) & ">"
End Function
